home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpsqapi1.zip / SQUISH.PAS < prev    next >
Pascal/Delphi Source File  |  1992-02-13  |  28KB  |  900 lines
  1. (*--------------------------------------------------------------------------
  2.                          SQUISH PASCAL BASED API
  3.                                version 1.0
  4.                   (c) copyright 1988-91 Santronics Software
  5.        Portions of the code is copyrighted by Alternative Unlimited Inc.
  6.  
  7.  
  8.  DISCLAIMER: Alternative Unlimited Inc and Santronics Software makes no
  9.  warrantly to the accuracy of these functions and data types. We take no
  10.  responsibility in their usage.  You as a programmer is RESPONSIBLE for
  11.  the usage of this library.
  12.  
  13.  NOTES:
  14.  
  15.  If you want voice SUPPORT for this library, you will have to pay for
  16.  our time. We charge $65 per hour.  All Major Credit Cards Accepted.
  17.  
  18.  Please do not use the Silver Xpress National Support Conferences for
  19.  reporting any bugs with this API. Netmail is preferred to either
  20.  1:129/82 or 1:290/4.
  21.  
  22.  There are two places where I see MAX has a potentially dynamic record
  23.  lengths. The BASE RECORD and the FRAME RECORD. It is important you are
  24.  aware of these so that future enhancements to your program will be
  25.  compatible with new MAX changes to the squish files. When a squish file
  26.  SQD is open, you should call SQSetSQBSize to reset the SQBSIZE variable
  27.  to proper the length, and when do you read in the BASE RECORD, set the
  28.  SBFSIZE variable to the value defined in the base record. Doing so,
  29.  will atleast conform to the way MAX today is setup for the future
  30.  changes in the base structure.
  31.  
  32.  There is no critical error trap routines here. It is your programming
  33.  responsibility to TRAP and CLOSE, and especially UNLOCK any open SQUISH
  34.  file if a critical error occurs.  There is a local unit variable
  35.  _SQD_FILE_LOCKED which is used here to determine if a message based is
  36.  locked when a closing function is called.  It is suggested that you test
  37.  for this variable's logical state in your critical error trap routine.
  38.  
  39. ----------------------------------------------------------------------------*)
  40.  
  41. {$A-   Use BYTE ALIGHMENT ONLY!!!!!!!!!!!!}
  42. {$O+   Make it OVERLAY ready. DONT FORGET TO FORCE FAR CALLS W/ COMPILER SWITCH}
  43. {$I-   No TURBO io file checking. You're on your own}
  44. {$X+   Use EXTENDED calls, ala C. Functions do not need return assignments}
  45. {$V-   ignore string parameter passing length checking}
  46.  
  47. {$IFDEF DEBUG}                             (* DEVELOPMENT CODE ONLY  *)
  48. {$D+   DEBUG INFO}
  49. {$L+   LOCAL SYMBOLS}
  50. {$R-   NO RANGE CHECKING BECAUSE OF DYNAMIC ARRAYS BELOW}
  51. {$S+   STACK CHECKING}
  52. {$ELSE}                                    (* PRODUCTION CODE ONLY   *)
  53. {$D-   NO DEBUG INFO}
  54. {$L-   NO LOCAL SYMBOLS}
  55. {$R-   NO RANGE CHECKING}
  56. {$S-   NO STACK CHECKING}
  57. {$ENDIF}
  58.  
  59. UNIT SQUISH;
  60.  
  61. (**************************************************************************
  62. Description:
  63.  
  64.     Squish has four files:
  65.  
  66.      *.SQL   - the lastread pointers are stored for the user. The lastus00.dat
  67.                file has the user's record number. Seek to it and read a word
  68.                to get lastread value for the user for the message base.
  69.  
  70.      *.SQI   - is a index of LIVE MESSAGES in the Squish *.SQD file. It
  71.                basically stores the 'unique' message id for each message,
  72.                the offset of the SQUISH messahe header (sqhdr) and the
  73.                HASH of the TOWHOM user's name.
  74.  
  75.      *.SQD   - has all the mail. The basic layout is:
  76.  
  77.                 BASE_RECORD
  78.  
  79.                 then for each message
  80.  
  81.                   SQUISH MESSAGE HEADER
  82.                   CONTROL INFORMATION   Where all ^A stuff is stored
  83.                   TEXT MESSAGE          may not always be null terminated
  84.  
  85.                The base record will tell you where the first squish msg header
  86.                is at, and each msg header will point to the next or prev one.
  87.  
  88.                In addition, the base record also will point to the first FREE
  89.                (one that was marked deleted) Squish Message Header and so on.
  90.  
  91.                So from the base record, you can get a "Doublely linked list"
  92.                of both the live messages and free messages.
  93.  
  94.       *.SQB  - something to do with dupe checking and I think it's for the
  95.                squish mail processor. Not discussed or used in the this API.
  96.  
  97. *****************************************************************************)
  98.  
  99. INTERFACE
  100.  
  101. Uses
  102.      crt,               (* only used for the DELAY() function      *)
  103.      Dos,               (* Turbo's DOS library                     *)
  104.      iofiles,           (* Santronics stream I/O functions         *)
  105.      strlib,            (* Santronics String Library               *)
  106.      fidofmt;           (* your basic SDM (*.MSG) header format    *)
  107.  
  108. TYPE
  109.  
  110.     UMSGID_TYPE     = longint;
  111.     RECPOS_TYPE     = longint;
  112.     _Address        = record zone,net,node,point : Word end;
  113.     MsgBufType      = Array[0..0] of Char;
  114.     MsgBufPtrtype   = ^MsgBufType;
  115.  
  116. CONST
  117.  
  118.     SQHDRID         = $AFAE4453;  (* squish headers must have this number *)
  119.     LINKNEXT        = 0;
  120.     LINKPREV        = 1;
  121.     NULLFRAME       = 0;
  122.     FRAME_msg       = 0;          (* it's a live message *)
  123.     FRAME_free      = 1;          (* the message is dead, avail for new msg *)
  124.     FRAME_rle       = 2;          (* type of compression, not implemented *)
  125.     FRAME_lzw       = 3;          (* type of compression, not implemented *)
  126.     SQMSG_FROM_SIZE = 36;
  127.     SQMSG_TO_SIZE   = 36;
  128.     SQMSG_SUBJ_SIZE = 72;
  129.     MAX_REPLY       = 10;         (* Max number of stored replies to one msg  *)
  130.  
  131. (* This is the first RECORD in the *.SQD file *)
  132.  
  133. type _sqbasetype =
  134.    record
  135.     len     : word;           (* LENGTH OF THIS STRUCTURE!   0   2 *)
  136.     rsvd1   : word;           (* Reserved word   2   4 *)
  137.     num_msg,                  (* number of msgs   4   8 *)
  138.     high_msg,                 (* highest msg -  always equal to num_msg   8  12 *)
  139.     skip_msg: longint;        (* # of msgs to keep in beginning of area  12  16 *)
  140.     high_water : UMSGID_TYPE; (* High water marker (umsgid)  16  20 *)
  141.     uid        : UMSGID_TYPE; (* Last usmgid  20  24 *)
  142.     base       : string[79];  (* Base name for SquishFile  24 104 *)
  143.     begin_frame,              (* Offset of first frame in file 104 108 *)
  144.     last_frame,               (* Offset to last frame in file 108 112 *)
  145.     first_free,               (* Offset of first FREE frame in file 112 116 *)
  146.     last_free,                (* Ofs of the last free frame 116 120 *)
  147.     end_frame  : RECPOS_TYPE; (* Pointer to end of file 120 124 *)
  148.     max_msg    : longint;     (* Maximum number of messages 124 128 *)
  149.     keep_days  : word;        (* Max age of messages 128 130 *)
  150.     sz_sqhdr   : word;        (* Size of fram header 130 132 *)
  151.     rsvd2      : array[1..124] of byte       (* Reserved area 132 256 *)
  152.    end;
  153.  
  154. (*
  155.  After thge BASE record, follows a frame record for EACH message. The
  156.  begin_frame in the base should point to the first frame header, and
  157.  the next_frame in the frame header should point to the next one, etc.
  158. *)
  159.  
  160. type _sqfhdrtype =
  161.    record
  162.     id          : longint;        (* sqhdr.id must always equal SQHDRID *)
  163.     next_frame,                   (* pointer to next msg in base *)
  164.     prev_frame  : RECPOS_TYPE;    (* pointer to prior msg in base *)
  165.     frame_length,                 (* length of this frame (not counting header) *)
  166.     msg_length,                   (* length of msg in frame. may be less than
  167.                                      frame_length if this frame has been recycled. *)
  168.     clen        : longint;        (* Length of the control information. *)
  169.     frame_type  : word;           (* Either FRAME_MESSAGE or FRAME_FREE. The API
  170.                                      has been designed to allow things such
  171.                                      as FRAME_LZSS or FRAME_LZH to be hacked on
  172.                                      later, without changing the application. *)
  173.     rsvd        : word;           (* Reserved *)
  174.   end;
  175.  
  176. (*
  177.  
  178. But right after each frame header, follows the squish message header,
  179. then the control info, then the text.
  180.  
  181. *)
  182.  
  183. type _sqmhdrtype =
  184.     record
  185.       attr      : longint;
  186.       fromwhom  : string[SQMSG_FROM_SIZE-1];
  187.       towhom    : string[SQMSG_TO_SIZE-1];
  188.       subj      : string[SQMSG_SUBJ_SIZE-1];
  189.       orig,
  190.       dest      : _ADDRESS;                   (* Origination and destination addresses *)
  191.       date_written,                       (* When user wrote the msg (UTC) *)
  192.       date_arrived  : longint;            (* When msg arrived on-line (UTC) *)
  193.       utc_ofs   : word;                   (* Minutes offset from UTC of message writer *)
  194.       replyto   : UMSGID_TYPE;
  195.       replies   : array[1..MAX_REPLY] of UMSGID_TYPE;
  196.       azdate    : string[19];             (* ASCII date *)
  197.     end;
  198.  
  199.  
  200. (*
  201.   Each SQD file has a SQI FILES.  The message number YOU see (the user)
  202.   in MAX is really the counter starting from 1 of each record in SQI.
  203.   But the TRUE UNIQUE Message ID is in umsgid. The ofs value will
  204.   point to the frame header in SQD.  These files are small and you
  205.   may read them into a array SqiPtrArrayType using the functions
  206.   below.
  207.  
  208. *)
  209.  
  210. type _sqidxtype = record
  211.                  ofs    : RECPOS_TYPE;           (* Offset of frame header *)
  212.                  umsgid : UMSGID_TYPE;           (* Unique message identifier *)
  213.                  hash   : longint;               (* 'To' name hash value *)
  214.                end;
  215.     SqiPtrArraytype = Array[1..1] of _sqidxtype;
  216.     Sqiptrtype      = ^sqiptrarraytype;
  217.  
  218.  
  219. (*
  220.  
  221. Sizes of various structures.  WARNING, alot of the routines use these
  222. variables. You should be more dynamic and reading the true sizes SCOTT
  223. puts in the squish structures (if any).
  224.  
  225. *)
  226.  
  227. CONST
  228.  
  229.    _SQBSIZE : word = SizeOf(_sqbasetype);
  230.    _SQFSIZE : word = SizeOf(_sqfhdrtype);
  231.    _SQMSIZE : word = SizeOf(_sqmhdrtype);
  232.    _SQISIZE : word = SizeOf(_sqidxtype);
  233.    _SDMSIZE : word = SizeOf(_fidomsgtype);
  234.  
  235. (*
  236.  
  237. Function Prototypes in this unit.
  238.  
  239. *)
  240.  
  241. function SqSetSQBSize(var fd: File): Integer;
  242. function SqOpenSQD(name: String; var fd: File; Lock : boolean): Integer;
  243. function SqCloseSQD(var fd: File): Integer;
  244. function SqReadBHdr(var fd: File; var sb: _sqbasetype): Integer;
  245. function SqWriteBHdr(var fd: File; var sb: _sqbasetype): Integer;
  246. function SqReadFHdr(var fd: File; var sf: _sqfhdrtype; fp: LongInt): Integer;
  247. function SqWriteFHdr(var fd: File; var sf: _sqfhdrtype; fp: LongInt): Integer;
  248. function SqReadMHdr(var fd: File; var sm: _sqmhdrtype; fp: LongInt): Integer;
  249. function SqWriteMHdr(var fd: File; var sm: _sqmhdrtype; fp: LongInt): Integer;
  250. function SqReadMTxt(var fd: File; var st; fp: LongInt; ml: LongInt): Integer;
  251. function SqWriteMTxt(var fd: File; var st; fp: LongInt; ml: LongInt): Integer;
  252. function SqOpenSQI(name: String; var fd: File): Integer;
  253. function SqCloseSQI(var fd: File): Integer;
  254. function SqReadSQI(var fd: File; var si: _sqidxtype; fp: LongInt): Integer;
  255. function SqWriteSQI(var fd: File; var si: _sqidxtype; fp: LongInt): Integer;
  256. function SDMRead(name: String; var mh: _fidomsgtype; var mb: MsgBufPtrtype; var mz: LongInt): Integer;
  257. function SqUnlinkFrame(var fd: File; var sf: _sqfhdrtype): Integer;
  258. function SqLinkFrame(var fd: File; var sf: _sqfhdrtype; tp, lp: LongInt; op: Word): Integer;
  259. function SqFreeFrame(var fd: File; var sb: _sqbasetype; rp: LongInt): Integer;
  260. function SqFindFrame(var fd: File; var sb: _sqbasetype; var fl, rp: LongInt): Integer;
  261. function SqNewFrame(var fd: File; var sb: _sqbasetype; var sf: _sqfhdrtype; var ml, rp: LongInt): Integer;
  262. function SqReplaceFrame(var fd: File; var sb: _sqbasetype; var sf: _sqfhdrtype; var rp, ml: LongInt): Integer;
  263.  
  264. function SqAzHashName(var s): LongInt;
  265. function SqHashName (name : str35) : longint;
  266. Procedure SquishSQIPtr(var sqiptr : sqiptrtype; fn :Pathstr; var sqisize : longint);
  267. function SquishMsgnToUid(var sqiptr : sqiptrtype; Msgn : word ; totalsqi : word) : longint;
  268. function SquishUidToMsgn(var sqiptr : sqiptrtype; uid : longint; totalsqi : word) : word;
  269. function GetSquishBaseRec(fn : pathstr; var sqbaserec : _sqbasetype) : integer;
  270. Function SetSquishMsgAttribute
  271.                               (
  272.                                var fvsqd : file;
  273.                                var fpos : longint;
  274.                                newattr : longint
  275.                               ) : integer;
  276.  
  277. implementation
  278.  
  279. (* Open a "*.SQD" file *)
  280.  
  281. CONST _SQD_FILE_LOCKED : BOOLEAN = FALSE;  (* DONT FUSS WITH THIS VARIABLE *)
  282.  
  283. function SqOpenSQD(name: String; var fd: File; lock : boolean): Integer;
  284. var
  285.    r   : Integer;
  286.    ax  : integer;
  287.    Cnt : Integer;
  288. begin
  289.    r  := Fopen(fd,ForceExtension(name,'SQD'),_READWRITE+_DENYNONE);
  290.    ax := r;
  291.    if (r = 0) and lock and (not _SQD_FILE_LOCKED) then
  292.       begin
  293.         Cnt := 1500;
  294.         repeat
  295.          if not FileLock(FileRec(fd).handle,LockRegion,0,1,ax) then
  296.            begin
  297.             case ax of
  298.               33,        (* lock voilation  *)
  299.               32,        (* share voilation *)
  300.               5,         (* access denied   *)
  301.               167        (* hardware share voilation *)
  302.                  : Delay(10);
  303.             end;
  304.             Dec(cnt);
  305.            end
  306.          else begin
  307.                ax := 0;
  308.                _SQD_FILE_LOCKED := TRUE;
  309.               end;
  310.         until (Cnt=0) or (ax=0);
  311.       end;
  312.    SqOpenSQD := ax;
  313. end;
  314.  
  315. (* Close a "*.SQD" file *)
  316.  
  317. function SqCloseSQD(var fd: File): Integer;
  318. var
  319.    r: Integer;
  320.    ax : integer;
  321.  
  322. begin
  323.    r := 5;
  324.    if _SQD_FILE_LOCKED then
  325.       if Not FileLock(FileRec(fd).handle,UnLockRegion,0,1,ax)
  326.          Then WRITELN(#13#10'>>ERR#',ax,' :FAILED TO UNLOCK ',Mat2Str(FileRec(fd).Name,50))
  327.          else _SQD_FILE_LOCKED := FALSE;
  328.    r := fclose(fd);
  329.    SqCloseSQD := r
  330. end;
  331.  
  332. (* Read any data from a "*.SQD" file *)
  333.  
  334. function SqReadData(var fd: File; var da; fp: LongInt; sz: Word): Integer;
  335. var
  336.    r: Integer;
  337. begin
  338.    Seek(fd,fp);
  339.    r := IoResult;
  340.    if (r = 0) then
  341.    begin
  342.       BlockRead(fd,da,sz,r);
  343.       r := IoResult
  344.    end;
  345.    SqReadData := r
  346. end;
  347.  
  348. (* Write any data to a "*.SQD" file *)
  349.  
  350. function SqWriteData(var fd: File; var da; fp: LongInt; sz: Word): Integer;
  351. var
  352.    r: Integer;
  353. begin
  354.    Seek(fd,fp);
  355.    r := IoResult;
  356.    if (r = 0) then
  357.    begin
  358.       BlockWrite(fd,da,sz,r);
  359.       r := IoResult
  360.    end;
  361.    SqWriteData := r
  362. end;
  363.  
  364. (* Read a "*.SQD" base header. MAKE SURE SQBSIZE IS SET CURRENTLY FOR
  365.    THE VERSION MAX *)
  366.  
  367. function SqReadBHdr(var fd: File; var sb: _sqbasetype): Integer;
  368. begin
  369.    SqReadBHdr := SqReadData(fd,sb,0,_SQBSIZE)
  370. end;
  371.  
  372. (*
  373.    Read a "*.SQD" base header structure SIZE. Once you call the SqOPENSQB
  374.    you should call this function to make sure the SQBSIZE variable is
  375.    current.
  376. *)
  377.  
  378. function SqSetSQBSize(var fd: File): Integer;
  379.  begin
  380.    SqSetSQBSize := SqReadData(fd,_SQBSIZE,0,sizeof(word))
  381.  end;
  382.  
  383. (* Write a "*.SQD" base header *)
  384.  
  385. function SqWriteBHdr(var fd: File; var sb: _sqbasetype): Integer;
  386. begin
  387.    SqWriteBHdr := SqWriteData(fd,sb,0,_SQBSIZE)
  388. end;
  389.  
  390. (* Read a "*.SQD" frame header *)
  391.  
  392. function SqReadFHdr(var fd: File; var sf: _sqfhdrtype; fp: LongInt): Integer;
  393. begin
  394.    SqReadFHdr := SqReadData(fd,sf,fp,_SQFSIZE)
  395. end;
  396.  
  397. (* Write a "*.SQD" frame header *)
  398.  
  399. function SqWriteFHdr(var fd: File; var sf: _sqfhdrtype; fp: LongInt): Integer;
  400. begin
  401.    SqWriteFHdr := SqWriteData(fd,sf,fp,_SQFSIZE)
  402. end;
  403.  
  404. (* Read a "*.SQD" message header *)
  405.  
  406. function SqReadMHdr(var fd: File; var sm: _sqmhdrtype; fp: LongInt): Integer;
  407. begin
  408.    SqReadMHdr := SqReadData(fd,sm,fp+_SQFSIZE,_SQMSIZE)
  409. end;
  410.  
  411. (* Write a "*.SQD" message header *)
  412.  
  413. function SqWriteMHdr(var fd: File; var sm: _sqmhdrtype; fp: LongInt): Integer;
  414. begin
  415.    SqWriteMHdr := SqWriteData(fd,sm,fp+_SQFSIZE,_SQMSIZE)
  416. end;
  417.  
  418. (* Read a "*.SQD" message text *)
  419.  
  420. function SqReadMTxt(var fd: File; var st; fp: LongInt; ml: LongInt): Integer;
  421. begin
  422.    SqReadMTxt := SqReadData(fd,st,fp+_SQFSIZE+_SQMSIZE,ml-_SQMSIZE)
  423. end;
  424.  
  425. (* Write a "*.SQD" message text *)
  426.  
  427. function SqWriteMTxt(var fd: File; var st; fp: LongInt; ml: LongInt): Integer;
  428. begin
  429.    SqWriteMTxt := SqWriteData(fd,st,fp+_SQFSIZE+_SQMSIZE,ml-_SQMSIZE)
  430. end;
  431.  
  432. (* Open a "*.SQI" file *)
  433.  
  434. function SqOpenSQI(name: String; var fd: File): Integer;
  435. begin
  436.    SqOpenSQI := fopen(fd,ForceExtension(name,'SQI'),_READWRITE+_DENYNONE);
  437. end;
  438.  
  439. (* Close a "*.SQI" file *)
  440.  
  441. function SqCloseSQI(var fd: File): Integer;
  442. begin
  443.    SqCloseSqI := fclose(fd);
  444. end;
  445.  
  446. (* Read a "*.SQI" index record *)
  447.  
  448. function SqReadSQI(var fd: File; var si: _sqidxtype; fp: LongInt): Integer;
  449. var
  450.    r: Integer;
  451. begin
  452.    Seek(fd,fp*_SQISIZE);
  453.    r := IoResult;
  454.    if (r = 0) then
  455.    begin
  456.       BlockRead(fd,si,_SQISIZE,r);
  457.       r := IoResult
  458.    end;
  459.    SqReadsqi := r
  460. end;
  461.  
  462. (* Write a "*.SQI" index record *)
  463.  
  464. function SqWriteSQI(var fd: File; var si: _sqidxtype; fp: LongInt): Integer;
  465. var
  466.    r: Integer;
  467. begin
  468.    Seek(fd,fp*_SQISIZE);
  469.    r := IoResult;
  470.    if (r = 0) then
  471.    begin
  472.       BlockWrite(fd,si,_SQISIZE,r);
  473.       r := IoResult
  474.    end;
  475.    SqWritesqi := r
  476. end;
  477.  
  478. (* Open and read a "*.MSG" file *)
  479.  
  480. function SDMRead(name: String; var mh: _fidomsgtype; var mb: MsgBufptrType; var mz: LongInt): Integer;
  481. var
  482.    rc: Integer;
  483.    br: Word;
  484.    fd: File;
  485. begin
  486.    Assign(fd,name);
  487.    Reset(fd,1);
  488.    rc := IoResult;
  489.    mb := NIL;
  490.    if (rc = 0) then
  491.      begin
  492.       BlockRead(fd,mh,_SDMSIZE,br);
  493.       mz := FileSize(fd) - _SDMSIZE;
  494.       GetMem(mb,mz);
  495.       BlockRead(fd,mb^,mz,br);
  496.       if (mb^[br] <> #0) then mb^[br] := #0;  (* Force a null terminator *)
  497.       Close(fd)
  498.      end;
  499.    SDMread := rc
  500. end;
  501.  
  502. (* Unlink a frame from the chain *)
  503.  
  504. function SqUnlinkFrame(var fd: File; var sf: _sqfhdrtype): Integer;
  505. var
  506.    r: Integer;
  507.    sh: _sqfhdrtype;
  508. begin
  509.    r := 0;
  510.    if (sf.prev_frame <> 0) then
  511.    begin
  512.       r := SqReadFHdr(fd,sh,sf.prev_frame);
  513.       if (r = 0) then
  514.       begin
  515.          sh.next_frame := sf.next_frame;
  516.          r := SqWriteFHdr(fd,sh,sf.prev_frame)
  517.       end
  518.    end;
  519.    if ((r = 0) and (sf.next_frame <> 0)) then
  520.    begin
  521.       r := SqReadFHdr(fd,sh,sf.next_frame);
  522.       if (r = 0) then
  523.       begin
  524.          sh.prev_frame := sf.prev_frame;
  525.          r := SqWriteFHdr(fd,sh,sf.next_frame)
  526.       end
  527.    end;
  528.    SqUnlinkFrame := r
  529. end;
  530.  
  531. function SqLinkFrame(var fd: File; var sf: _sqfhdrtype; tp, lp: LongInt; op: Word): Integer;
  532. var
  533.    r: Integer;
  534.    nxt: LongInt;
  535.    sh: _sqfhdrtype;
  536. begin
  537.    r := 0;
  538.    if (tp <> NULLFRAME) then
  539.    begin
  540.       r := SqReadFHdr(fd,sh,tp);
  541.       if (r = 0) then
  542.       begin
  543.          if (op = LINKNEXT) then
  544.          begin
  545.             sf.prev_frame := tp;
  546.             nxt := sh.next_frame;
  547.             sh.next_frame := lp
  548.          end
  549.          else
  550.          begin
  551.             sf.next_frame := tp;
  552.             nxt := sh.prev_frame;
  553.             sh.prev_frame := lp
  554.          end;
  555.          r := SqWriteFHdr(fd,sh,tp);
  556.          tp := nxt
  557.       end;
  558.       if ((r = 0) and (tp <> NULLFRAME)) then
  559.       begin
  560.          r := SqReadFHdr(fd,sh,tp);
  561.          if (r = 0) then
  562.          begin
  563.             if (op = LINKNEXT) then
  564.             begin
  565.                sh.prev_frame := lp;
  566.                sf.next_frame := tp
  567.             end
  568.             else
  569.             begin
  570.                sf.prev_frame := tp;
  571.                sh.next_frame := lp
  572.             end;
  573.             r := SqWriteFHdr(fd,sh,tp)
  574.          end
  575.       end
  576.    end;
  577.    SqLinkFrame := r
  578. end;
  579.  
  580. function SqRelinkFrame(var fd: File; var sf: _sqfhdrtype; rp: LongInt): Integer;
  581. var
  582.    r: Integer;
  583. begin
  584.    if (sf.next_frame = NULLFRAME) then
  585.       r := SqLinkFrame(fd,sf,sf.prev_frame,rp,LINKNEXT)
  586.    else
  587.       r := SqLinkFrame(fd,sf,sf.next_frame,rp,LINKPREV);
  588.    SqRelinkFrame := r
  589. end;
  590.  
  591. function SqFreeFrame(var fd: File; var sb: _sqbasetype; rp: LongInt): Integer;
  592. var
  593.    r: Integer;
  594.    sqn,
  595.    sqn1: _sqfhdrtype;
  596. begin
  597.    r := SqReadFHdr(fd,sqn,rp);
  598.    if (r = 0) then
  599.    begin
  600.       r := SqUnlinkFrame(fd,sqn);
  601.       if (r = 0) then
  602.       begin
  603.          if (sb.begin_frame = rp) then
  604.             sb.begin_frame := sqn.next_frame;
  605.          if (sb.last_frame = rp) then
  606.             sb.last_frame := sqn.prev_frame;
  607.          sqn.frame_type := Word(FRAME_free);
  608.          if (sb.first_free = NULLFRAME) then
  609.          begin
  610.             sb.first_free := rp;
  611.             sb.last_free := rp;
  612.             sqn.prev_frame := NULLFRAME;
  613.             sqn.next_frame := NULLFRAME
  614.          end
  615.          else
  616.          begin
  617.             r := SqReadFHdr(fd,sqn1,sb.last_free);
  618.             if (r = 0) then
  619.             begin
  620.                sqn1.next_frame := rp;
  621.                r := SqWriteFHdr(fd,sqn1,sb.last_free);
  622.                sqn.prev_frame := sb.last_free;
  623.                sqn.next_frame := NULLFRAME
  624.             end
  625.          end;
  626.          if (r = 0) then
  627.          begin
  628.             sb.last_free := rp;
  629.             r := SqWriteFHdr(fd,sqn,rp)
  630.          end
  631.       end
  632.    end;
  633.    SqFreeFrame := r
  634. end;
  635.  
  636. function SqFindFrame(var fd: File; var sb: _sqbasetype; var fl, rp: LongInt): Integer;
  637. var
  638.    r: Integer;
  639.    sqn: _sqfhdrtype;
  640.    break: Boolean;
  641. begin
  642.    r := 0;
  643.    break := FALSE;
  644.    rp := sb.first_free;
  645.    while ((rp > NULLFRAME) and (not break)) do
  646.    begin
  647.       r := SqReadFHdr(fd,sqn,rp);
  648.       if ((r = 0) and (fl < sqn.frame_length)) then
  649.          break := TRUE
  650.       else
  651.          rp := sqn.next_frame
  652.    end;
  653.    if (r = 0) then
  654.    begin
  655.       if (rp = NULLFRAME) then
  656.       begin
  657.          fl := 0;
  658.          rp := sb.end_frame
  659.       end
  660.       else
  661.       begin
  662.          r := SqUnlinkFrame(fd,sqn);
  663.          if (r = 0) then
  664.          begin
  665.             if (sqn.prev_frame = NULLFRAME) then
  666.                sb.first_free := sqn.next_frame;
  667.             if (sqn.next_frame = NULLFRAME) then
  668.                sb.last_free := sqn.prev_frame;
  669.             fl := sqn.frame_length
  670.          end
  671.       end
  672.    end;
  673.    SqFindFrame := r
  674. end;
  675.      
  676. function SqNewFrame(var fd: File; var sb: _sqbasetype; var sf: _sqfhdrtype; var ml, rp: LongInt): Integer;
  677. var
  678.    r: Integer;
  679.    sqn: _sqfhdrtype;
  680. begin
  681.    r := SqFindFrame(fd,sb,ml,rp);
  682.    if (r = 0) then
  683.    begin
  684.       if (sb.last_frame <> NULLFRAME) then
  685.       begin
  686.          r := SqReadFHdr(fd,sqn,sb.last_frame);
  687.          if (r = 0) then
  688.          begin
  689.             sqn.next_frame := rp;
  690.             r := SqWriteFHdr(fd,sqn,sb.last_frame)
  691.          end
  692.       end
  693.       else
  694.          sb.begin_frame := rp;
  695.       if (r = 0) then
  696.       begin
  697.          sf.id := SQHDRID;
  698.          sf.frame_type := Word(FRAME_msg);
  699.          sf.prev_frame := sb.last_frame;
  700.          sb.last_frame := rp;
  701.          sf.next_frame := NULLFRAME
  702.       end
  703.    end;
  704.    SqNewFrame := r
  705. end;
  706.  
  707. function SqReplaceFrame(var fd: File; var sb: _sqbasetype; var sf: _sqfhdrtype; var rp, ml: LongInt): Integer;
  708. var
  709.    r: Integer;
  710. begin
  711.    r := SqReadFHdr(fd,sf,rp);
  712.    if (r = 0) then
  713.    begin
  714.       if (ml > sf.frame_length) then
  715.       begin
  716.          r := SqFreeFrame(fd,sb,rp);
  717.          if (r = 0) then
  718.          begin
  719.             sf.frame_length := ml;
  720.             r := SqFindFrame(fd,sb,sf.frame_length,rp);
  721.             if (r = 0) then
  722.             begin
  723.                if (sf.prev_frame = NULLFRAME) then
  724.                   sb.begin_frame := rp;
  725.                if (sf.next_frame = NULLFRAME) then
  726.                   sb.last_frame := rp
  727.             end
  728.          end
  729.       end
  730.    end;
  731.    SqReplaceFrame := r
  732. end;
  733.  
  734. (* Convert a asciiz username into a hash value for the index. The logic
  735.    used in this code (pointer arithmetic) is ok to use because we are
  736.    dealing with small lengths and will never exceed 64k.
  737. *)
  738.  
  739. function SqAzHashName(var s): LongInt;
  740. var
  741.    p: ^Char;
  742.    g,
  743.    hash: LongInt;
  744. begin
  745.    hash := 0;
  746.    p := @s;
  747.    while (p^ <> #0) do
  748.    begin
  749.       hash := (hash shl 4) + Byte(locase(p^));
  750.       g := (hash and $f0000000);
  751.       if (g <> 0) then
  752.       begin
  753.          hash := (hash or (g shr 24));
  754.          hash := (hash or g)
  755.       end;
  756.       Inc(LongInt(p))
  757.    end;
  758.    SqAzHashName := (hash and $7fffffff)
  759. end;
  760.  
  761. (* Convert a Pascal username into a hash value for the index.
  762. *)
  763.  
  764. function SqHashName (name : str35) : longint;
  765. var p      : integer;
  766.     hash,g : longint;
  767.  begin
  768.     hash := 0;
  769.     for p := 1 to length(name) do
  770.        begin
  771.         hash := (hash shl 4) + ord(locase(name[p]));
  772.         g    := hash and $F0000000;
  773.         if (g <> 0) then
  774.           begin
  775.               hash := hash or (g shr 24);
  776.               hash := hash or g;
  777.           end;
  778.        end;
  779.     SqHashName := hash and $7fffffff;
  780.  end;
  781.  
  782. (*
  783. The following functions are used convert back and forth between between
  784. the msg number and the unique msg id in the sqi files.  You should use
  785. these for lastread pointers, reply links, etc.
  786. *)
  787.  
  788.  
  789. function SquishUidToMsgn(var sqiptr : sqiptrtype; uid : longint; totalsqi : word) : word;
  790. var idx     : word;
  791.  begin
  792.    SquishUidToMsgn := 0;
  793.    if (sqiptr <> NIL) and (totalsqi > 0) and (uid > 0) then
  794.      begin
  795.        idx := 1;
  796.        while (uid > sqiptr^[idx].umsgid) and ((Idx) <= totalsqi) do inc(idx);
  797.        if idx > totalsqi then Idx := TotalSqi;
  798.        SquishUidToMsgn := idx;
  799.      end;
  800.  end;
  801.  
  802. function SquishMsgnToUid(var sqiptr : sqiptrtype; Msgn : word ; totalsqi : word) : longint;
  803.  begin
  804.    SquishMsgnToUid := 0;
  805.    if (sqiptr <> NIL) and (TotalSqi > 0) then
  806.      begin
  807.        if Msgn > totalSqi then Msgn := totalsqi;
  808.        if Msgn = 0 then Msgn := 1;
  809.        SquishMsgnToUid := sqiptr^[msgn].umsgid;
  810.      end;
  811.  end;
  812.  
  813. (*
  814.  Open SQI file and read in the entire file.  This is your INDEX system
  815.  to the SQD files. Once in memory, you can cycle thru this list by
  816.  msg #, UID # or user name (hash) and get the offset to the Squish header
  817.  record in the SQD file. (Double check the SQHDR_ID value to make sure
  818.  the record is valid).
  819.  
  820.   ie,  Var sqiptr   : sqpptrtype;
  821.            sqisize  : longint;
  822.            actrecs  : word;
  823.  
  824.        SquishSQIPtr(sqiptr,'XPRESS.SQI',sqisize);
  825.        actrecs   := sqisize div _SQISIZE;
  826.  
  827.        .
  828.        .
  829.        .
  830.  
  831.        FreeMem(sqiptr,sqisize);
  832.  
  833.  Don't forget to FREE the the Sqiptr pointer variable using the sqisize
  834.  passed.
  835.  
  836. *)
  837.  
  838. Procedure SquishSQIPtr(var sqiptr : sqiptrtype; fn :Pathstr; var sqisize : longint);
  839. var  fv      : stream;
  840.      abytes  : word;
  841.  
  842.    begin
  843.      SqiPtr       := NIL;
  844.      sqisize      := 0;
  845.      if fopen(fv,fn,_READONLY+_DENYNONE) <> 0 then exit;
  846.      sqisize := filesize(fv);
  847.      if sqisize = 0 then
  848.        begin
  849.          fclose(fv);
  850.          exit;
  851.        end;
  852.      GetMem(sqiptr,sqisize);
  853.      if sqiptr <> NIL then Blockread(fv,sqiptr^,sqisize,abytes);
  854.      fclose(fv);
  855.    end;
  856.  
  857. function GetSquishBaseRec(fn : pathstr; var sqbaserec : _sqbasetype) : integer;
  858. var fv : stream;
  859.     ax : integer;
  860.     ab : word;
  861.  begin
  862.    ax := fopen(fv,fn,_READONLY+_DENYNONE);
  863.    GetSquishBaseRec := ax;
  864.    if ax = 0 then
  865.      begin
  866.        (* SQ BASE *)
  867.        blockread(fv,sqbaserec,_SQBSIZE,ab);
  868.        fclose(fv);
  869.      end;
  870.  end;
  871.  
  872. (*
  873.  
  874. Given message frame position, read message header and set the message
  875. attribute bit.  The newattr is ORed to the previous value.
  876.  
  877. *)
  878.  
  879. Function SetSquishMsgAttribute
  880.                               (
  881.                                var fvsqd : file;
  882.                                var fpos : longint;
  883.                                newattr : longint
  884.                               ) : integer;
  885. var
  886.     xmsg         : _sqmhdrtype;
  887.  
  888.   begin
  889.    SetSquishMsgAttribute := -1;
  890.    if SqReadMhdr(fvsqd,xmsg,fpos) = 0 then
  891.       begin
  892.        xmsg.attr := xmsg.attr or NEWATTR;
  893.        SetSquishMsgAttribute := SqWriteMHdr(fvsqd,xmsg,fpos);
  894.       end;
  895.   end;
  896.  
  897.  
  898. end. (**************************************************** END OF API ****)
  899.  
  900.